perm filename PICTUR.SAI[SYS,HE]1 blob
sn#004178 filedate 1972-09-25 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 BEGIN "PICTUR"
00009 00003 α table of picture file data block names
00012 00004 α Compute the transformation matrices for the camera model
00020 00005 α update the camera transform
00024 00006 α Initialized the camera transform routines
00026 00007 α convert text in array to string
00028 00008 α first we initialize the world
00030 00009 α get a picture from the disk
00033 00010 α get a picture from the TV
00035 00011 α determine which filters he wants to use
00037 00012 α set sensitivity
00041 00013 α and, finally, take the picture
00043 00014 α display the picture, if clear picture
00046 00015 α output to disk if desired
00049 00016 α return for next picture
00050 ENDMK
⊗;
BEGIN "PICTUR"
REQUIRE "HELIB[1,3]" LIBRARY;
REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
REQUIRE 2000 STRING_SPACE;
REQUIRE "⊂⊃||" DELIMITERS;
DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃, CRLF=⊂'15&'12⊃,
BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
QUEST(NOVICE,QUESTION,TEST)=
⊂BEGIN IF ¬EXP THEN OUTSTR("NOVICE"&CRLF);
DO OUTSTR("QUESTION"&CRLF)
UNTIL TEST; END⊃,
RED=⊂2⊃, BLUE=⊂3⊃, GREEN=⊂4⊃, CLEAR=⊂1⊃, XDATA=⊂3⊃;
EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO RELCOR(INT IOWD);
EXT INT PRO GETCOR(INT SIZE);
EXT BOOLEAN PRO VIDEO(INT EXP, X,Y);
EXT PRO INP;
EXT INT PRO GIOWD(INT ARRAY BUF);
EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
EXT PRO CWHEEL(INT CODE);
EXT PRO TVIN;
EXT PRO PRDUMP;
EXT PRO PORTR;
FORTRAN REAL PROCEDURE SIN;
FORTRAN REAL PROCEDURE COS;
FORTRAN REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
EXTERNAL PROCEDURE CALLEN;
EXTERNAL PROCEDURE SPWOFF;
EXT PROCEDURE INVRT(REAL ARRAY A,AI);
EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS;
SAFE INT ARRAY PNTRS[1:25], DPYBUF[1:600], CLIPS[1:4,1:3];
SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,MART,SWING,
FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
INT I, EXP, ANS, FSAV, LLSAV, RSAV, LSAV, TVLENG, PICNUM, CAMERR;
REAL PANPOT, FOCPOT, TILPOT;
LABEL LOOP, SKIP, SKIP1;
BOOLEAN SENSSET, TVREAD;
STRING STR, TITLE, DESCRIPT;
α table of picture file data block names;
PRELOAD_WITH "LEFT (ONLY) CLEAR IMAGE",
"LEFT (ONLY) RED IMAGE",
"LEFT (ONLY) BLUE IMAGE",
"LEFT (ONLY) GREEN IMAGE",
"TITLE",
"DESCRIPTION",
"LEFT (ONLY) CAMERA TRANSFORM",
"LEFT (ONLY) CLEAR CODE TABLE",
"RIGHT CLEAR IMAGE",
"RIGHT RED IMAGE",
"RIGHT BLUE IMAGE",
"RIGHT GREEN IMAGE",
"RIGHT CAMERA TRANSFORM",
"RIGHT CLEAR CODE TABLE",
"STEREO REGISTRATION TABLE",
"MISC. 16",
"MISC. 17",
"MISC. 18",
"MISC. 19",
"MISC. 20",
"MISC. 21",
"MISC. 22",
"MISC. 23",
"MISC. 24",
"MISC. 25";
SAFE STRING ARRAY PICDES[1:25];
SAFE INTEGER ARRAY PICALLOC[1:25]; α allocation table for data blocks;
PRELOAD_WITH "Clear","Red", "Blue", "Green";
SAFE STRING ARRAY FILNAM[1:4];
PRELOAD_WITH 3,0,1,2;
SAFE INT ARRAY COLNUM[1:4];
SIMPLE REAL PROCEDURE LNS(REAL X; INTEGER RLENS);
RETURN(X*FOC[RLENS]/(X-FOC[RLENS]));
α INDIRECT ARRBLT;
SIMPLE PROCEDURE ARRTO(INTEGER TOO; REFERENCE INTEGER FROM; INTEGER LENG);
START_CODE JRST ARRBLT; END;
SIMPLE PROCEDURE ARRFROM(REFERENCE INTEGER TOO; INTEGER FROM, LENG);
START_CODE JRST ARRBLT; END;
SIMPLE PROCEDURE ARRTOR(INTEGER TOO; REFERENCE REAL FROM;INTEGER LENG);
START_CODE JRST ARRBLT; END;
α Compute the transformation matrices for the camera model;
PROCEDURE PANTIL_CAM(INTEGER CLENS;REAL PPOT,TPOT,FPOT;REAL ARRAY COL,ICOL,CENTER);
BEGIN INTEGER I,J;
REAL ACC,FMX,FMY,PAN,TILT;
REAL ARRAY RP,RT,RPT,RS,R[1:3,1:3],C[1:3];
PAN←PPOTD[CLENS]*PPOT+PPOT0[CLENS];
TILT←TPOTD[CLENS]*TPOT+TPOT0[CLENS];
FMY←FPOTD[CLENS]*FPOT+FPOT0[CLENS];
FMX←FMY*MART[CLENS];
RP[2,3]←-1;
RPT[1,1]←RP[1,1]←RP[3,2]←-SIN(PAN);
RP[3,1]←-(RPT[1,2]←RP[1,2]←COS(PAN));
RT[1,1]←1;
RPT[2,3]←-(RT[2,2]←RT[3,3]←COS(TILT));
R[3,3]←RPT[3,3]←RT[2,3]←-(RT[3,2]←SIN(TILT));
RPT[2,1]←RT[2,3]*RP[3,1];
RPT[2,2]←RT[2,3]*RP[3,2];
R[3,1]←RPT[3,1]←RT[3,3]*RP[3,1];
R[3,2]←RPT[3,2]←RT[3,3]*RP[3,2];
RS[3,3]←1;
RS[1,1]←RS[2,2]←COS(SWING[CLENS]);
RS[2,1]←-(RS[1,2]←SIN(SWING[CLENS]));
R[1,1]←RS[1,1]*RPT[1,1]+RS[1,2]*RPT[2,1];
R[1,2]←RS[1,1]*RPT[1,2]+RS[1,2]*RPT[2,2];
R[1,3]←RS[1,2]*RPT[2,3];
R[2,1]←RS[2,1]*RPT[1,1]+RS[2,2]*RPT[2,1];
R[2,2]←RS[2,1]*RPT[1,2]+RS[2,2]*RPT[2,2];
R[2,3]←RS[2,2]*RPT[2,3];
C[1]←P0[CLENS,1]+R[1,1]*DP[CLENS,1]+R[2,1]*DP[CLENS,2]+R[3,1]*DP[CLENS,3];
C[2]←P0[CLENS,2]+R[1,2]*DP[CLENS,1]+R[2,2]*DP[CLENS,2]+R[3,2]*DP[CLENS,3];
C[3]←P0[CLENS,3]+R[1,3]*DP[CLENS,1]+R[2,3]*DP[CLENS,2]+R[3,3]*DP[CLENS,3];
α -FMX/333 and PP[2]-PP[1]/333 are corrections for the non-orthogonality of the TV scan axes;
FOR I←1 STEP 1 UNTIL 3 DO
BEGIN
COL[I,1]←R[I,1];
COL[I,2]←R[I,2];
ACC←0;
FOR J←1 STEP 1 UNTIL 3 DO ACC←ACC-R[I,J]*C[J];
COL[I,3]←ACC;
END;
FOR J←1 STEP 1 UNTIL 3 DO
BEGIN
COL[2,J]←-FMX/333*COL[1,J]+FMY*COL[2,J]
+(PP[CLENS,2]-PP[CLENS,1]/333)*COL[3,J];
COL[1,J]←FMX*COL[1,J]+PP[CLENS,1]*COL[3,J];
END;
INVRT(COL,ICOL);
ARRTRAN(CENTER,C);
END "PANTIL_CAM";
α update the camera transform;
INTEGER PROCEDURE CAM_UPDATE;
BEGIN
INTEGER SFOC,STIL,SPAN,IND,FMAX,FMIN,TMAX,TMIN,PMAX,PMIN,
DIFFOC,DIFTIL,DIFPAN,SIND,UPDFLG;
LABEL ETA;
SAFE REAL ARRAY MCOL,MICOL [1:3,1:3]; α WHERE I KEEP CURRENT CAMERA XFORM;
SAFE REAL ARRAY LCEN[1:3]; α AND LENS CENTER ;
ETA: UPDFLG ← SFOC←STIL←SPAN←0;
FMAX←TMAX←PMAX←-10000;
FMIN←TMIN←PMIN←10000;
STATUS←1;
SPWON(1,TSERVO);
FOR IND←0 STEP 1 UNTIL 39 DO
BEGIN
STATUS←4;
WHILE ¬(STATUS LAND 1) DO;
IF (STATUS≥'100)∧(STATUS<'100000) THEN DONE;
SFOC←SFOC+P1;
STIL←STIL+P2;
SPAN←SPAN+P3;
IF P1>FMAX THEN FMAX←P1;
IF P1<FMIN THEN FMIN←P1;
IF P2>TMAX THEN TMAX←P2;
IF P2<TMIN THEN TMIN←P2;
IF P3>PMAX THEN PMAX←P3;
IF P3<PMIN THEN PMIN←P3;
END;
SPWOFF;
IF IND>0 THEN
BEGIN
L1←FOCPOT←SFOC/IND;
L2←TILPOT←STIL/IND;
L3←PANPOT←SPAN/IND;
IF IND<30 THEN
BEGIN
OUTSTR("CAM_UPDATE: NOT ENOUGH READINGS ("&CVS(IND)&")"&CRLF);
UPDFLG←8;
END ELSE BEGIN
DIFFOC←FMAX-FMIN;
DIFTIL←TMAX-TMIN;
DIFPAN←PMAX-PMIN;
SIND←4*SQRT(IND);
IF (DIFPAN/SIND>.5)∨(DIFTIL/SIND>.25)∨(DIFFOC/SIND>1) THEN
BEGIN
OUTSTR("CAM_UPDATE: POTS TOO NOISY ("&CVS(DIFFOC)&" "&
CVS(DIFTIL)&" "&CVS(DIFPAN)&")"&CRLF);
UPDFLG←9;
END;
END;
END ELSE BEGIN
OUTSTR("CAM_UPDATE: AD NOT AVAILABLE"&CRLF);
UPDFLG←10;
END;
IF UPDFLG≠0 THEN
BEGIN
OUTSTR("...TYPE Y TO TRY AGAIN:"&CRLF);
IF INCHWL= "Y" THEN GOTO ETA;
IF UPDFLG=10 THEN
BEGIN
OUTSTR("CAM_UPDATE-FAILED: CAMERA_MODEL NOT UPDATED"&CRLF);
RETURN(UPDFLG);
END;
END;
CALLEN;
PANTIL_CAM (LENS,PANPOT,TILPOT,FOCPOT,MCOL,MICOL,LCEN);
α Now to update the global model;
ARRBLT (CAMERA_MODEL[1,1],MCOL[1,1],9);
ARRBLT (CAMERA_MODEL[6,1],MICOL[1,1],9);
ARRBLT (CAMERA_MODEL[4,1],LCEN[1],3);
CAMERA_MODEL[5,1] ← PP[LENS,1];
CAMERA_MODEL[5,2] ← PP[LENS,2];
CAMERA_MODEL[5,3] ← 1.0;
CAMERA_MODEL[9,1]←PPOTD[LENS]*PANPOT+PPOT0[LENS];
CAMERA_MODEL[9,2]←TPOTD[LENS]*TILPOT+TPOT0[LENS];
CAMERA_MODEL[9,3]←LNS(FOCLEN0[LENS]+FOCLENG[LENS]*FOCPOT,LENS);
CAMERA_MODEL[10,2]←LENS;
RETURN(UPDFLG);
END "CAM_UPDATE";
α Initialized the camera transform routines;
INTEGER PROCEDURE CAM_INIT;
BEGIN INTEGER J, BLOCK;
INTEGER PROCEDURE DATXFR; α READS DATA IN GILL'S FORMAT;
BEGIN BOOLEAN FLAG;
INTEGER I;
DEFINE DATASET=⊂"DATA[SYS,HE]"⊃;
DEFINE XFR(X)=⊂ARRYIN(XDATA,X,1)⊃;
OPEN(XDATA,"DSK",12,3,0,0,0,0);
LOOKUP(XDATA,DATASET,FLAG);
IF FLAG THEN
BEGIN
OUTSTR("DATXFR-FAILED: LOOKUP FAILED FOR "&DATASET&CRLF);
RETURN(7);
END;
USETI(XDATA,1);
WORDIN(XDATA);
USETI(XDATA,BLOCK);
XFR(PPOT0[BLOCK]);
XFR(PPOTD[BLOCK]);
XFR(TPOT0[BLOCK]);
XFR(TPOTD[BLOCK]);
XFR(FPOT0[BLOCK]);
XFR(FPOTD[BLOCK]);
XFR(MART[BLOCK]);
XFR(SWING[BLOCK]);
FOR I←1,2 DO XFR(|PP[BLOCK,I]|);
FOR I←1,2,3 DO XFR(|P0[BLOCK,I]|);
FOR I←1,2,3 DO XFR(|DP[BLOCK,I]|);
XFR(FOC[BLOCK]);
XFR(FOCLEN0[BLOCK]);
XFR(FOCLENG[BLOCK]);
RELEASE(XDATA);
RETURN(0);
END "DATXFR";
FOR BLOCK←1 STEP 1 UNTIL 4 DO IF (J←DATXFR) THEN RETURN(J);
RETURN(0);
END"CAM_INIT";
α convert text in array to string;
STRING PROCEDURE STRCOM(INTEGER BUF);
BEGIN STRING FOO;
INTEGER STRT, LENG;
FOO ← NULL;
LENG ← ABS(BUF DIV (2↑18))+1;
STRT ← BHEAD(BUF);
BEGIN INTEGER ARRAY X[1:LENG];
INTEGER I, J;
ARRFROM(X[1],STRT,LENG);
FOR I←1 STEP 1 UNTIL LENG DO
BEGIN STRING Y;
Y ← CVSTR(X[I]);
FOR J←1 STEP 1 UNTIL 5 DO IF ¬Y[J FOR 1] THEN RETURN(FOO&(Y[1 TO J-1]));
FOO ← FOO&Y;
END;
END;
RETURN(FOO);
END;
α convert string to text in array;
INTEGER PROCEDURE ARRYCOM(STRING S);
BEGIN INTEGER STRT, LENG, BUF;
LENG ← LENGTH(S);
LENG ← IF ¬(LENG MOD 5) THEN LENG DIV 5 ELSE (LENG DIV 5)+1;
BEGIN INTEGER ARRAY X[1:LENG];
INTEGER I;
FOR I←1 STEP 1 UNTIL LENG DO
BEGIN
X[I] ← CVASC(S[1 FOR 5]);
S ← S[6 TO ∞];
END;
BUF ← GETCOR(LENG);
STRT ← BHEAD(BUF);
ARRTO(STRT,X[1],LENG);
END;
RETURN(BUF);
END;
α first we initialize the world;
TCLIP ← 0;
BCLIP ← 7;
SENSSET ← EXP ← FALSE;
CLIPS[1,1] ← -1;
ARRBLT(CLIPS[1,2],CLIPS[1,1],11);
PICALLOC[1] ← PNTRS[1] ← 0;
CAMERR ← CAM_INIT;
ARRBLT(PICALLOC[2],PICALLOC[1],24);
ARRBLT(PNTRS[2],PNTRS[1],24);
QUEST (|Responses to questions are the upper case letters in the question."&CRLF&
"All responses must be ended by a carriage return."&CRLF&
"Novices taking pictures for printer output should, if in doubt,"&CRLF&
"give the first reply indicated.|,
|are you an expert at running this program? (No or Yes)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
EXP ← ANS="Y";
LOOP: QUEST (|You can enter a picture live from the TV camera"&crlf&
"or a stored picture from the disk.|,
|Tv or Disk image?|,
|(ANS←INCHWL)="D"∨ANS="T"|);
IF ANS="D" THEN
α get a picture from the disk;
BEGIN "DISKIN"
INT FILE, EXTEN, PPN, FAIL;
TVREAD ← FALSE;
QUEST (|file names are of the form NAME.EXT[PROJ,PROG] where"&crlf&
"everything but NAME is optional.|,
|FILE NAME=|,TRUE);
FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
PICINI(1,FILE,EXTEN,PPN,FAIL,PNTRS);
IF FAIL THEN USERERR(0,0,"LOOKUP ON FILE "&STR&" FAILED");
OUTSTR("PICTURE FILE "&STR&" CONSISTS OF:"&CRLF);
FOR I←1 STEP 1 UNTIL 25 DO IF PNTRS[I] THEN OUTSTR(" "&PICDES[I]&CRLF);
QUEST (| You can read in the entire picture file or select any of the parts listed.|,
|All parts or Select?|,
|(ANS←INCHWL)="A"∨ANS="S"|);
IF ANS="S" THEN OUTSTR("type 'Y' for parts wanted, anything else if not wanted"&CRLF);
FOR I←1 STEP 1 UNTIL 25 DO IF PNTRS[I] THEN
BEGIN "GETPART"
IF ANS="S" THEN OUTSTR(" "&PICDES[I]&"?");
IF ANS≠"S"∨INCHWL="Y" THEN PNTRS[I]←BHEAD((PICALLOC[I]←GETCOR(PNTRS[I])))
ELSE PNTRS[I] ← PICALLOC[I] ← 0;
END "GETPART" ELSE PNTRS[I] ← PICALLOC[I] ← 0;
PICRD(FAIL,PNTRS);
IF FAIL THEN USERERR(0,0,"INPUT OF FILE "&STR&" FAILED") ELSE RELEASE(1);
TVLENG ← (((RSIDE-LSIDE)/9)+1)*(LLINE-FLINE+1);
TITLE ← IF PNTRS[5] THEN STRCOM(PICALLOC[5]) ELSE NULL;
DESCRIPT ← IF PNTRS[6] THEN STRCOM(PICALLOC[6]) ELSE NULL;
OUTSTR("PICTURE TITLE IS:"&(IF LENGTH(TITLE) THEN TITLE ELSE "none")&CRLF);
IF LENGTH(DESCRIPT) THEN
BEGIN "OUTDES"
OUTSTR("picture has a description which is "&CVS(LENGTH(DESCRIPT))& " characters long"&CRLF);
OUTSTR("do you want to see it (Yes or No)?");
IF INCHWL="Y" THEN OUTSTR(DESCRIPT&CRLF);
END "OUTDES";
END "DISKIN" ELSE
α get a picture from the TV;
BEGIN "TVIN"
QUEST (|You can now set the area of the TV image to be read in."&crlf&
"The white rectangle on the TV monitor shows the area being read."&crlf&
"The four knobs on the pot box near console 21 change the rectangle."&crlf&
"12 and 13 change the location of the upper left corner."&crlf&
"Knobs 14 and 15 change the length and width.|,| |,TRUE);
α adjust size if picture, if desired;
IF TVREAD THEN
BEGIN "ADJREC"
QUEST (| |,|same area as last time? (Yes or No)|,|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN GO TO SKIP;
END "ADJREC";
OUTSTR("Adjust the image. Type any character when you are done."&CRLF);
BEGIN INTEGER ARRAY BUF[1:10000];
TVWORD ← GIOWD(BUF);
INP;
CLRBUF;
FSAV ← FLINE;
LLSAV ← LLINE;
RSAV ← RSIDE;
LSAV ← LSIDE;
END;
TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
DESCRIPT ← TITLE ←NULL;
α determine which filters he wants to use;
SKIP: QUEST (| This program can read a black & white picture,"&crlf&
"a color picture (using the blue, green, and red filters)"&crlf&
"or a mixture|,
|Black & white, Color, or you Select filters?|,
|(ANS←INCHWL)="B"∨ANS="C"∨ANS="S"|);
TVREAD ← TRUE;
PICNUM ← 1;
IF ANS="B" THEN PICALLOC[CLEAR] ← GETCOR(TVLENG) ELSE
IF ANS="C" THEN
BEGIN
PICALLOC[RED] ← GETCOR(TVLENG);
PICALLOC[BLUE] ← GETCOR(TVLENG);
PICALLOC[GREEN] ← GETCOR(TVLENG);
PICNUM ← 3;
END ELSE BEGIN
OUTSTR("type Y for filters desired"&CRLF);
PICNUM ← 0;
FOR I ← 1 STEP 1 UNTIL 4 DO
BEGIN
OUTSTR(FILNAM[I]&" FILTER?");
IF INCHWL="Y" THEN
BEGIN
PICALLOC[I] ← GETCOR(TVLENG);
PICNUM ← PICNUM+1;
END;
END;
END;
IF ¬PICNUM THEN
BEGIN
OUTSTR("You have to select at least one !!!"&CRLF);
GO TO SKIP;
END;
α set sensitivity;
IF SENSSET THEN
BEGIN "ALLSET"
QUEST (|you can change the sensitivity again or use the"&crlf&
"same settings as the the picture you read|,
|change sensitivity? (No or Yes)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="N" THEN GO TO SKIP1;
END "ALLSET" ELSE BEGIN "STEST"
SENSSET ← TRUE;
QUEST (| You can adjust the TV sensitivity to get the contrast"&CRLF&
"you want. A horizontal line, whose position is controlled"&crlf&
"by knob 12 of the pot box, is read in and an intensity"&crlf&
"vs. position display is shown. The clip levels can be"&crlf&
"changed by knobs 14 and 15. (0≤TCLIP≤BCLIP≤7)|,
|set clips? (Yes or No)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="N" THEN GO TO SKIP1;
END "STEST";
IF PICNUM>1 THEN
BEGIN "SETSEL"
QUEST (| You may set the sensitivity for each filter seperately,"&crlf&
"or for all at once, using one of the filters you selected.|,
|set sensitivity for All or One?|,
|(ANS←INCHWL)="A"∨ANS="O"|);
IF ANS="A" THEN FOR I←1 STEP 1 UNTIL 4 DO CLIPS[I,1]←-2 ELSE
BEGIN "WHICH" LABEL LOOP1;
LOOP1: STR ← "set sensitivity with filter:";
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN STR ← STR&" "&FILNAM[I];
OUTSTR(STR&"?");
ANS ← INCHWL;
I←IF ANS="R" THEN 1 ELSE IF ANS="B" THEN 2 ELSE IF ANS="G" THEN 3 ELSE
IF ANS="C" THEN 4 ELSE 0;
IF ¬I∨PICALLOC[I] THEN GO TO LOOP1 ELSE CLIPS[I,1]←-2;
END "WHICH";
END "SETSEL" ELSE FOR I←1 STEP 1 UNTIL 4 DO CLIPS[I,1]←-2;
OUTSTR("Type Y when satisfied"&crlf);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I]∧CLIPS[I,1]=-2 THEN
BEGIN "SENSET"
OUTSTR(FILNAM[I]&" FILTER"&CRLF);
CWHEEL(COLNUM[I]);
EYECAL(600,1,TRUE,DPYBUF);
CLIPS[I,1] ← BCLIP;
CLIPS[I,2] ← TCLIP;
CLRBUF;
END "SENSET";
RELPOG(1);
SKIP1: FOR I←1 STEP 1 UNTIL 4 DO IF CLIPS[I,1]<0 THEN
BEGIN CLIPS[I,1] ← BCLIP; CLIPS[I,2] ← TCLIP;END;
α and, finally, take the picture;
FLINE ← FSAV;
LLINE ← LLSAV;
RSIDE ← RSAV;
LSIDE ← LSAV;
OUTSTR("type a carriage return to take the picture(s)");
INCHWL;
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
BEGIN "TAKE" INTEGER N;
EXTERNAL INTEGER IND;
CWHEEL(6);
IF IND≠COLNUM[I] THEN
BEGIN
CWHEEL(COLNUM[I]);
N ← 12000;
WHILE N←N-1 DO;
END;
TVWORD ← PICALLOC[I];
BCLIP ← CLIPS[I,1];
TCLIP ← CLIPS[I,2];
TVIN;
END "TAKE";
QUEST(|If this picture is to be used by the hand/eye system"&crlf&
"it should have a camera transform|,
|store a camera transform (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN
IF ¬CAMERR THEN CAMERR←CAMERR∨(CAM_UPDATE=10);
IF CAMERR THEN OUTSTR("CAMERA ERROR - NO TRANSFORM"&CRLF) ELSE
BEGIN
PICALLOC[7] ← GETCOR(30);
ARRTOR(BHEAD(|PICALLOC[7]|),CAMERA_MODEL[1,1],30);
END;
END;
END "TVIN";
α display the picture, if clear picture;
IF PICALLOC[1] THEN
BEGIN "DDVID"
QUEST(|you can display your picture on the data disk displays"&crlf&
"if DDVID[1,PDQ] is running somewhere. The picture will be"&crlf&
"on channel 47|,
|display with DDVID (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN
TVWORD←PICALLOC[1];
WHILE TRUE DO
BEGIN INTEGER J;
J←VIDEO(1,10,10);
IF J THEN DONE;
OUTSTR("Video failed. Try again (Yes or No)?"&CRLF);
IF INCHWL≠"Y" THEN DONE;
END;
END;
END "DDVID";
α print the picture(s) if desired;
QUEST (|Now you can output the picture(s) to the line printer, if you wish,"&crlf&
"either by printing the intensity values, or simulating grey scale.|,
|print Grey scale, Intensities, or Nothing?|,
|(ANS←INCHWL)="G"∨ANS="I"∨ANS="N"|);
IF ANS≠"N" THEN
BEGIN "PRINT" LABEL LOOP2;
IF ANS="G" THEN PRTBUF←GETCOR(TVLENG);
LOOP2: OPEN(1,"LPT",0,0,2,1000,I,I);
OUT(1,TITLE&CRLF);
OUT(1,DESCRIPT&CRLF);
OUT(1,CRLF&"UNDER FILTERS: ");
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN OUT(1," "&FILNAM[I]);
OUT(1,CRLF);
RELEASE(1);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
BEGIN
TVWORD ← PICALLOC[I];
IF ANS="G" THEN PORTR ELSE PRDUMP;
END;
OUTSTR("another copy (Yes or No)?"&CRLF);
IF INCHWL="Y" THEN GO TO LOOP2;
IF ANS="G" THEN RELCOR(PRTBUF);
END "PRINT";
α output to disk if desired;
QUEST (| |,|send picture(s) to the disk (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN "DSKOUT"
INTEGER FILE, PPN, EXTEN, FAIL;
LABEL LOOP3;
IF LENGTH(TITLE) THEN
OUTSTR("title is: "&TITLE&CRLF&"would you like to change it (No or Yes)?") ELSE
OUTSTR("there is no title"&crlf&"would you like one (Yes or No)?");
IF INCHWL="Y" THEN
BEGIN
OUTSTR("type new title, ending with carriage return"&crlf);
TITLE ← INCHWL;
END;
IF LENGTH(DESCRIPT) THEN
BEGIN
OUTSTR("would you like to see the description again (Yes or No)?");
IF INCHWL="Y" THEN OUTSTR(DESCRIPT&CRLF);
OUTSTR("would you like to change the description (No or Yes)?");
END ELSE OUTSTR("would you like to add a description (Yes of No)?");
IF INCHWL="Y" THEN
BEGIN
IF LENGTH(DESCRIPT) THEN
BEGIN
OUTSTR("Add to or Replace?");
IF INCHWL="R" THEN DESCRIPT ← NULL;
END;
OUTSTR("type new description or addition, ending with carraige return ∀ carriage return");
WHILE TRUE DO IF LENGTH(STR←INCHWL)∧STR[1 FOR 1]="∀" THEN DONE ELSE
DESCRIPT ← DESCRIPT&STR&CRLF;
END;
IF PICALLOC[5] THEN RELCOR(PICALLOC[5]);
IF PICALLOC[6] THEN RELCOR(PICALLOC[6]);
PICALLOC[5] ← IF LENGTH(TITLE) THEN ARRYCOM(TITLE) ELSE 0;
PICALLOC[6] ← IF LENGTH(DESCRIPT) THEN ARRYCOM(DESCRIPT) ELSE 0;
FOR I←1 STEP 1 UNTIL 25 DO PNTRS[I]←IF PICALLOC[I] THEN PICALLOC[I]+1 ELSE 0;
LOOP3: OUTSTR("FILE NAME=");
FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "&STR&" FAILED"); GO TO LOOP3;END;
OUTSTR("FILE "&STR&" WRITTEN OUT"&CRLF);
END "DSKOUT";
α return for next picture;
FOR I←1 STEP 1 UNTIL 25 DO
BEGIN
IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
PICALLOC[I] ← PNTRS[I] ← 0;
END;
OUTSTR("another picture (Yes or No)?");
IF INCHWL ="Y" THEN
BEGIN
IF ¬EXP THEN
BEGIN
OUTSTR("are you an expert yet (Yes or No)?");
EXP ← INCHWL="Y";
END;
GO TO LOOP;
END;
END;